home *** CD-ROM | disk | FTP | other *** search
/ Windows Game Programming for Dummies (2nd Edition) / WinGamProgFD.iso / pc / DirectX SDK / DXSDK / samples / Multimedia / VBSamples / Misc / DXSetup / registry.bas < prev    next >
Encoding:
BASIC Source File  |  2001-10-08  |  8.4 KB  |  169 lines
  1. Attribute VB_Name = "modRegistry"
  2. Option Explicit
  3. Option Compare Text
  4.  
  5. Private Const gsSLASH_BACKWARD As String = "\"
  6.  
  7. ''Registry API Declarations...
  8. Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  9. Private Declare Function RegCreateKeyEx Lib "advapi32" Alias "RegCreateKeyExA" _
  10.     (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, _
  11.     ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, _
  12.     ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, ByRef phkResult As Long, _
  13.     ByRef lpdwDisposition As Long) As Long
  14. Private Declare Function RegDeleteKey Lib "advapi32" Alias "RegDeleteKeyA" _
  15.     (ByVal hKey As Long, ByVal lpSubKey As String) As Long
  16. Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" _
  17.     (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
  18.     ByVal samDesired As Long, ByRef phkResult As Long) As Long
  19. Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" _
  20.     (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
  21.     ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
  22. Private Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" _
  23.     (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
  24.     ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
  25. Private Declare Function RegEnumValue Lib "advapi32" Alias "RegEnumValueA" _
  26.     (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, _
  27.     ByRef lpcbValueName As Long, ByVal lpReserved As Long, ByRef lpType As Long, _
  28.     ByVal lpData As String, ByRef lpcbData As Long) As Long
  29. Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" _
  30.     (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, _
  31.     lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As Long, _
  32.     ByVal lpcbClass As Long, lpftLastWriteTime As FileTime) As Long
  33.  
  34. ''Reg Data Types...
  35. Private Const REG_NONE = 0                                          ' No value type
  36. Private Const REG_SZ = 1                                            ' Unicode nul terminated string
  37. Private Const REG_EXPAND_SZ = 2                                     ' Unicode nul terminated string
  38. Private Const REG_BINARY = 3                                        ' Free form binary
  39. Private Const REG_DWORD = 4                                         ' 32-bit number
  40. Private Const REG_DWORD_LITTLE_ENDIAN = 4                           ' 32-bit number (same as REG_DWORD)
  41. Private Const REG_DWORD_BIG_ENDIAN = 5                              ' 32-bit number
  42. Private Const REG_LINK = 6                                          ' Symbolic Link (unicode)
  43. Private Const REG_MULTI_SZ = 7                                      ' Multiple Unicode strings
  44. Private Const REG_RESOURCE_LIST = 8                                 ' Resource list in the resource map
  45. Private Const REG_FULL_RESOURCE_DESCRIPTOR = 9                      ' Resource list in the hardware description
  46. Private Const REG_RESOURCE_REQUIREMENTS_LIST = 10
  47.  
  48. ''Reg Create Type Values...
  49. Private Const REG_OPTION_RESERVED = 0                               ' Parameter is reserved
  50. Private Const REG_OPTION_NON_VOLATILE = 0                           ' Key is preserved when system is rebooted
  51. Private Const REG_OPTION_VOLATILE = 1                               ' Key is not preserved when system is rebooted
  52. Private Const REG_OPTION_CREATE_LINK = 2                            ' Created key is a symbolic link
  53. Private Const REG_OPTION_BACKUP_RESTORE = 4                         ' open for backup or restore
  54.  
  55. ''Reg Key Security Options...
  56. Private Const READ_CONTROL = &H20000
  57. Private Const KEY_QUERY_VALUE = &H1
  58. Private Const KEY_SET_VALUE = &H2
  59. Private Const KEY_CREATE_SUB_KEY = &H4
  60. Private Const KEY_ENUMERATE_SUB_KEYS = &H8
  61. Private Const KEY_NOTIFY = &H10
  62. Private Const KEY_CREATE_LINK = &H20
  63. Private Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL
  64. Private Const KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY + READ_CONTROL
  65. Private Const KEY_EXECUTE = KEY_READ
  66. Private Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE _
  67.                             + KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS _
  68.                             + KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
  69.  
  70. ''Return Value...
  71. Private Const ERROR_SUCCESS = 0
  72. Private Const ERROR_ACCESS_DENIED = 5&
  73. Private Const ERROR_NO_MORE_ITEMS = 259&
  74.  
  75. ''Hierarchy separator
  76. Private Const KeySeparator As String = "\"
  77.  
  78. ''Registry Security Attributes TYPE...
  79. Private Type SECURITY_ATTRIBUTES
  80.     nLength As Long
  81.     lpSecurityDescriptor As Long
  82.     bInheritHandle As Boolean
  83. End Type
  84. Private Type FileTime
  85.     dwLowDateTime As Long
  86.     dwHighDateTime As Long
  87. End Type
  88.  
  89. ''Reg Key ROOT Types...
  90. Public Enum REGToolRootTypes
  91.     HK_CLASSES_ROOT = &H80000000
  92.     HK_CURRENT_USER = &H80000001
  93.     HK_LOCAL_MACHINE = &H80000002
  94.     HK_USERS = &H80000003
  95.     HK_PERFORMANCE_DATA = &H80000004
  96.     HK_CURRENT_CONFIG = &H80000005
  97.     HK_DYN_DATA = &H80000006
  98. End Enum
  99.  
  100. 'Retrieves a key value.
  101. Public Function GetKeyValue(ByVal KeyRoot As REGToolRootTypes, KeyName As String, ValueName As String, ByRef ValueData As String) As Boolean
  102.     Dim i As Long                                                   ' Loop Counter
  103.     Dim hKey As Long                                                ' Handle To An Open Registry Key
  104.     Dim KeyValType As Long                                          ' Data Type Of A Registry Key
  105.     Dim sTmp As String                                              ' Tempory Storage For A Registry Key Value
  106.     Dim sReturn As String
  107.     Dim KeyValSize As Long                                          ' Size Of Registry Key Variable
  108.     Dim sByte As String
  109.  
  110.     If ValidKeyName(KeyName) Then
  111.         On Error GoTo LocalErr
  112.  
  113.         ' Open registry key under KeyRoot
  114.         Attempt RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)
  115.  
  116.         sTmp = String$(1024, 0)                                         ' Allocate Variable Space
  117.         KeyValSize = 1024                                               ' Mark Variable Size
  118.  
  119.         ' Retrieve Registry Key Value...
  120.         Attempt RegQueryValueEx(hKey, ValueName, 0, _
  121.                 KeyValType, sTmp, KeyValSize)                           ' Get/Create Key Value
  122.  
  123.         If (Asc(Mid$(sTmp, KeyValSize, 1)) = 0) Then                     ' Win95 Adds Null Terminated String...
  124.             sTmp = Left$(sTmp, KeyValSize - 1)                           ' Null Found, Extract From String
  125.         Else                                                            ' WinNT Does NOT Null Terminate String...
  126.             sTmp = Left$(sTmp, KeyValSize)                               ' Null Not Found, Extract String Only
  127.         End If
  128.  
  129.         ' Determine Key Value Type For Conversion...
  130.         Select Case KeyValType                                          ' Search Data Types...
  131.             Case REG_SZ                                                 ' String Registry Key Data Type
  132.                 sReturn = sTmp '(Do nothing)
  133.             Case REG_DWORD                                              ' Double Word Registry Key Data Type
  134.                 For i = Len(sTmp) To 1 Step -1                          ' Convert Each Bit
  135.                     sByte = Hex(Asc(Mid$(sTmp, i, 1)))
  136.                     Do Until Len(sByte) = 2
  137.                         sByte = "0" & sByte
  138.                     Loop
  139.                     sReturn = sReturn & sByte                           ' Build Value Char. By Char.
  140.                 Next
  141.                 sReturn = Format$("&h" + sReturn)                       ' Convert Double Word To String
  142.         End Select
  143.  
  144.         GetKeyValue = True
  145.         ValueData = sReturn
  146.  
  147. LocalErr:
  148.         On Error Resume Next
  149.         RegCloseKey hKey
  150.     End If
  151. End Function
  152.  
  153. Private Sub Attempt(rc As Long)
  154.     If (rc <> ERROR_SUCCESS) Then
  155.         Err.Raise 5
  156.     End If
  157. End Sub
  158.  
  159. Private Function ValidKeyName(KeyName As String) As Boolean
  160.     'A key name is invalid if it begins or ends with \ or contains \\
  161.     If Left$(KeyName, 1) <> gsSLASH_BACKWARD Then
  162.         If Right$(KeyName, 1) <> gsSLASH_BACKWARD Then
  163.             If InStr(KeyName, gsSLASH_BACKWARD & gsSLASH_BACKWARD) = 0 Then
  164.                 ValidKeyName = True
  165.             End If
  166.         End If
  167.     End If
  168. End Function
  169.